{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Utilities;

interface

uses Classes, Dialogs;

const
  // Windows privileges
  SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
  SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
  SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
  SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
  SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
  SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
  SE_TCB_NAME = 'SeTcbPrivilege';
  SE_SECURITY_NAME = 'SeSecurityPrivilege';
  SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
  SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
  SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
  SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
  SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
  SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
  SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
  SE_BACKUP_NAME = 'SeBackupPrivilege';
  SE_RESTORE_NAME = 'SeRestorePrivilege';
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  SE_DEBUG_NAME = 'SeDebugPrivilege';
  SE_AUDIT_NAME = 'SeAuditPrivilege';
  SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
  SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
  SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';
  SE_UNDOCK_NAME = 'SeUndockPrivilege';
  SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege';
  SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege';
  SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege';

  // Typical default gamma brightness setting
  DEFAULT_BRIGHTNESS = 128;

  // Balloon tips registry key
  EXPLORER_KEY = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced';
  BALLOON_VALUE = 'EnableBalloonTips';

type
  TAHMExitWindows = (ewLogOff, ewSleep, ewHibernate, ewPowerOff, ewRestart);
  TAHMDriveType = (drvUnknown, drvRemovable, drvFixed, drvNetwork, drvOptical);
  TAHMDriveTypes = set of TAHMDriveType;
  TAHMWindowsPaths = (wpWindows, wpSystem, wpAppData, wpProgramFiles,
                      wpMyDocuments, wpMyMusic, wpMyVideos, wpMyPictures);

  function ParseStringValues(Value: String; var V1, V2: Integer): Boolean; overload;
  function ParseStringValues(Value: String; var V1, V2, V3: Single): Boolean; overload;

  procedure DisableSystemBalloonTips;
  procedure EnableSystemBalloonTips;
  procedure ResetSystemBalloonTips;

  procedure DisableSystemScreenSaver;
  procedure EnableSystemScreenSaver;
  procedure PreventDisplayPowerSave;
  procedure SetScreenBrightness(Brightness: Byte);
  procedure RestoreScreenBrightness;

  function RequestPrivilege(PrivilegeName: String): Boolean;
  procedure RevokePrivilege(PrivilegeName: String);
  function ExitWindows(Action: TAHMExitWindows): Boolean;

  procedure DisplayBrowserHome;
  procedure DisplayBrowserSales;
  procedure DisplayBrowserFeedback;
  procedure DisplayBrowserSupport;
  procedure DisplayBrowserCodecs;
  procedure DisplayBrowserPlugins;
  procedure DisplayBrowser(URL: String);

  function ApplicationURL: String;
  function ApplicationName: String;
  function ApplicationPath: String;
  function ApplicationTempPath: String;
  function ApplicationVersion: String;

  function OpenAssociatedApp(const Filename: String): Boolean;
  function OpenSpecifiedApp(const AppName, Filename: String): Boolean;
  function GetAssociatedApp(const Filename: String): String;
  function SetAssociatedApp(const AppFilename, Extension, Description: String): Boolean;
  procedure EnumerateAppWindows(WindowList: TStringList);
  procedure FocusAppWindow(var WindowIndex: Integer; Next: Boolean = True);

  procedure LaunchProcess(ExecutableName, Parameters: String; WaitForCompletion: Boolean); overload;
  procedure LaunchProcess(ExecutableName, Parameters, WorkingDir: String; WaitForCompletion: Boolean); overload;
  function RunProcess(ExecutableName, Parameters: String; WaitForIdle: Boolean): Integer; overload;
  function RunProcess(ExecutableName, Parameters, WorkingDir: String; WaitForIdle: Boolean): Integer; overload;
  function KillProcess(ProcessId: Integer): Boolean;
  function ProcessRunning(const ExecutableName: String): Boolean;

  function FileSizeToString(FileSize: Integer): String;
  function ValidFileName(Filename: String): Boolean;
  function MakeUniqueFileName(Filename: String): String;
  function ExtractFileCaption(const FileName: String): String;

  function ParentFolder(Folder: String): String;
  function LastFolder(Path: String): String;
  function ChooseFolder(const Title: String; var Folder: String; AllowCreate: Boolean): Boolean;
  function ChooseFile(const Title: String; var Filename: String; AllowCreate: Boolean): Boolean; overload;
  function ChooseFile(const Title, Filter, DefaultExt, Root: String; var Filename: String; AllowCreate: Boolean): Boolean; overload;

  function GetWindowsPath(Kind: TAHMWindowsPaths): String;
  function GetVolumeName(Path: String): String;
  procedure GetDrives(Drives: TStrings; DriveTypes: TAHMDriveTypes);

  procedure EnumerateSerialPorts(Names, Descriptions: TStrings);

  function DurationToString(Millisecs: Cardinal): String; overload;
  function DurationToString(Duration: TDateTime): String; overload;
  function FrequencyToString(Frequency: LongWord): String;

  function IsWindowsVista: Boolean;
  procedure RemoveApplicationWindowFromTaskbar;
  function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType): Integer; overload;
  function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType;
                         Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
  function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType;
                         Buttons: TMsgDlgButtons; HelpCtx: Longint; Default: TMsgDlgBtn): Integer; overload;

implementation

uses Forms, Windows, ShellAPI, ShlObj, TLHelp32, Controls, SysUtils, Math,
     Registry, ActiveX, ComObj;

type
  TAHMGammaRamp = packed record
    Red:   array[0..255] of Word;
    Green: array[0..255] of Word;
    Blue:  array[0..255] of Word;
  end;

var
  FScreenSaverStatus: Boolean;
  FScreenGammaRamp: TAHMGammaRamp;
  FBalloonTipsStatus: Boolean;
  FApplicationVersion: String;
  FChooseInitialFolder: String;


//----------------------------------------------------------------------------//

function ParseStringValues(Value: String; var V1, V2: Integer): Boolean;
var
  iPos: Integer;
begin
  // Set default result - not found
  Result := False;

  if Value <> '' then
  begin
    // Look for comma delimiter
    iPos := Pos(',', Value);
    if iPos > 0 then
    begin
      try
        V1 := StrToInt(Copy(Value, 1, Pred(iPos)));
        V2 := StrToInt(Copy(Value, Succ(iPos), Length(Value)));
        Result := True;
      except
        // Mask conversion error and allow calling class to handle
      end;
    end;
  end;
end;

function ParseStringValues(Value: String; var V1, V2, V3: Single): Boolean;
var
  iPos, jPos: Integer;
begin
  // Set default result - not found
  Result := False;

  if Value <> '' then
  begin
    // Look for comma delimiters
    iPos := Pos(',', Value);
    jPos := LastDelimiter(',', Value);

    if (iPos > 0) and (jPos > 0) then
    begin
      try
        V1 := StrToFloat(Copy(Value, 1, Pred(iPos)));
        V2 := StrToFloat(Copy(Value, Succ(iPos), jPos - iPos - 1));
        V3 := StrToFloat(Copy(Value, Succ(jPos), Length(Value)));
        Result := True;
      except
        // Mask conversion error and allow calling class to handle
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------//

procedure GetSystemBalloonTipsStatus;
begin
  with TRegistry.Create do
  try
    Access := KEY_READ;
    RootKey := HKEY_CURRENT_USER;

    if OpenKey(EXPLORER_KEY, False) and ValueExists(BALLOON_VALUE) then
      FBalloonTipsStatus := (ReadInteger(BALLOON_VALUE) <> 0)
    else
      FBalloonTipsStatus := True;
  finally
    Free;
  end;
end;

procedure DisableSystemBalloonTips;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if OpenKey(EXPLORER_KEY, False) then WriteInteger(BALLOON_VALUE, 0);
  finally
    Free;
  end;
end;

procedure EnableSystemBalloonTips;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if OpenKey(EXPLORER_KEY, False) then WriteInteger(BALLOON_VALUE, 1);
  finally
    Free;
  end;
end;

procedure ResetSystemBalloonTips;
begin
  if FBalloonTipsStatus then EnableSystemBalloonTips
                        else DisableSystemBalloonTips;
end;

//----------------------------------------------------------------------------//

procedure GetSystemScreenSaverStatus;
var
  saverStatus: BOOL;
begin
  // Determine whether screen saver is enabled
  SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @saverStatus, 0);
  FScreenSaverStatus := saverStatus;
end;

procedure DisableSystemScreenSaver;
const
  SAVER_DISABLED = 0;
begin
  // Disable system screen saver
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, SAVER_DISABLED, nil, 0);
end;

procedure EnableSystemScreenSaver;
const
  SAVER_ENABLED = 1;
begin
  // Enable system screen saver, but only if previously enabled
  if FScreenSaverStatus then
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, SAVER_ENABLED, nil, 0);
end;

procedure PreventDisplayPowerSave;
begin
  // Prevent from monitor power saving from kicking in.
  SystemParametersInfo(SPI_SETPOWEROFFACTIVE, 0, nil, 0);
end;

procedure GetDefaultScreenBrightness;
var
  DC: HDC;
begin
  // Store existing gamma ramp for screen before we modify it
  DC := GetDC(0);
  GetDeviceGammaRamp(DC, FScreenGammaRamp);
  ReleaseDC(0, DC);
end;

procedure SetScreenBrightness(Brightness: Byte);
var
  i, Value: Integer;
  DC: HDC;
  Ramp: TAHMGammaRamp;
begin
  // Compute a graduated linear ramp for specified brightness
  for i := 0 to 255 do
  begin
    Value := Min(Round(i * (Brightness + 128) / 255), 255);
    Ramp.Red[i]   := Value shl 8; // Place value into MSB
    Ramp.Green[i] := Value shl 8;
    Ramp.Blue[i]  := Value shl 8;
  end;

  // Apply the new gamma ramp to the display
  DC := GetDC(0);
  SetDeviceGammaRamp(DC, Ramp);
  ReleaseDC(0, DC);
end;

procedure RestoreScreenBrightness;
var
  DC: HDC;
begin
  // Restore original screen gamma ramp
  DC := GetDC(0);
  SetDeviceGammaRamp(DC, FScreenGammaRamp);
  ReleaseDC(0, DC);
end;

//----------------------------------------------------------------------------//

function UpdatePrivilege(PrivilegeName: String; Enable: Boolean): Boolean;
var
  Handle: THandle;
  Privs: TTokenPrivileges;
  BufferLen, ReturnLen: DWORD;
begin
  // Set default result - failed to update privilege
  Result := False;

  // We only need to request privileges on Windows NT derived platforms
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    // Get token for our process
    if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Handle) then
    begin
      try
        // Find privilege with specified name
        FillChar(Privs, SizeOf(Privs), 0);
        if LookupPrivilegeValue(nil, PAnsiChar(PrivilegeName), Privs.Privileges[0].Luid) then
        begin
          Privs.PrivilegeCount := 1;
          // Enable or disable? Leave flag empty to disable
          if Enable then Privs.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
          BufferLen := SizeOf(Privs);

          // Adjust privileges for our process
          Result := AdjustTokenPrivileges(Handle, False, Privs, BufferLen, nil, ReturnLen);
        end;
      finally
        CloseHandle(Handle);
      end;
    end;
  end
  else
    // No need to request privs for older platforms - simulate success
    Result := True;
end;

function RequestPrivilege(PrivilegeName: String): Boolean;
begin
  // Use function above to grant privilege
  Result := UpdatePrivilege(PrivilegeName, True);
end;
  
procedure RevokePrivilege(PrivilegeName: String);
begin
  // Use function above to revoke privilege
  UpdatePrivilege(PrivilegeName, False);
end;

// Warning! use this function with care as it will shutdown/exit windows immediately.
// If hibernate is not supported PC will sleep instead.
function ExitWindows(Action: TAHMExitWindows): Boolean;
begin
  // Set default result - exit failed
  Result := False;

  // We need to elevate privileges to perform shutdown
  if not RequestPrivilege(SE_SHUTDOWN_NAME) then Exit;
  try
    case Action of
      ewLogOff:    Result := ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, 0);
      ewPowerOff:  Result := ExitWindowsEx(EWX_POWEROFF or EWX_FORCE, 0);
      ewRestart:   Result := ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0);
      ewSleep:     Result := SetSystemPowerState(True, True);
      ewHibernate: Result := SetSystemPowerState(False, True);
    end;
  finally
    RevokePrivilege(SE_SHUTDOWN_NAME);
  end;
end;

//----------------------------------------------------------------------------//

procedure DisplayBrowserHome;
begin
  // Show our site homepage
  DisplayBrowser(ApplicationURL);
end;

procedure DisplayBrowserSales;
begin
  // Should produce URL of http://www.athomemedia.co.uk/purchase/?product=mediate&version=1.0.0
  DisplayBrowser(ApplicationURL + '/purchase?product=' + ApplicationName + '&version=' + ApplicationVersion);
end;

procedure DisplayBrowserFeedback;
begin
  // Should produce URL of http://www.athomemedia.co.uk/feedback/?product=mediate&version=1.0.0
  DisplayBrowser(ApplicationURL + '/feedback?product=' + ApplicationName + '&version=' + ApplicationVersion);
end;

procedure DisplayBrowserSupport;
begin
  // Should produce URL of http://www.athomemedia.co.uk/help
  DisplayBrowser(ApplicationURL + '/help');
end;

procedure DisplayBrowserCodecs;
begin
  // Should produce URL of http://www.athomemedia.co.uk/codecs
  DisplayBrowser(ApplicationURL + '/codecs');
end;

procedure DisplayBrowserPlugins;
begin
  // Should produce URL of http://www.athomemedia.co.uk/plugins
  DisplayBrowser(ApplicationURL + '/plugins');
end;

procedure DisplayBrowser(URL: String);
begin
  // Very noddy - just execute the native assignment for a URL
  try
    ShellExecute(Application.Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
  except
  end;
end;

//----------------------------------------------------------------------------//

function ApplicationURL: String;
begin
  Result := 'http://www.athomemedia.co.uk';
end;

function ApplicationName: String;
begin
  Result := Application.Title;
end;

function ApplicationPath: String;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

function ApplicationTempPath: String;
var
  TempPath: array[0..MAX_PATH] of Char;
begin
  // Get system temporary directory path
  if GetTempPath(SizeOf(TempPath), @TempPath) <> 0 then
    Result := TempPath
  else
    Result := '';
end;

function ApplicationVersion: String;
var
  VerInfoSize: DWORD;
  VerValueSize: DWORD;
  Handle: DWORD;
  Major, Minor, Release: WORD;
//  Build: WORD;
  VerInfo: Pointer;
  VerValue: PVSFixedFileInfo;
begin
  // Use cached application version if available
  if FApplicationVersion <> '' then
  begin
    Result := FApplicationVersion;
    Exit;
  end;

  // Set default result - failed to determine version number
  Result := '?.?.?';

  // Determine size of File version info structure for our application exe
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Handle);

  // Allocate memory for the structure
  GetMem(VerInfo, VerInfoSize);
  try
    // Retrieve the version info structure for application exe
    if GetFileVersionInfo(PChar(ParamStr(0)), Handle, VerInfoSize, VerInfo) then
    begin
      // Now extract the root file information from our structure
      if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then
        with VerValue^ do
        begin
          // We only use the first 3 words for our version numbering (build is ignored)
          Major := dwFileVersionMS shr 16;
          Minor := dwFileVersionMS and $ffff;
          Release := dwFileVersionLS shr 16;
//          Build := dwFileVersionLS and $ffff;

          // Now build & cache our version string
          Result := IntToStr(Major) + '.' + IntToStr(Minor) + '.' + IntToStr(Release);
          FApplicationVersion := Result;
        end;
    end;
  finally
    // Free our version info structure memory
    FreeMem(VerInfo, VerInfoSize);
  end;
end;

//----------------------------------------------------------------------------//

function OpenAssociatedApp(const Filename: String): Boolean;
var
  Handle: Cardinal;
begin
  Result := False;
  try
    Handle := ShellExecute(Application.Handle, 'open', PChar(Filename), nil, nil, SW_SHOWNORMAL);
    Result := (Handle > SE_ERR_DLLNOTFOUND);
  except
  end;
end;

function OpenSpecifiedApp(const AppName, Filename: String): Boolean;
var
  Handle: Cardinal;
begin
  Result := False;
  try
    Handle := ShellExecute(Application.Handle, 'open', PChar(AppName), PChar(Filename), nil, SW_SHOWNORMAL);
    Result := (Handle > SE_ERR_DLLNOTFOUND);
  except
  end;
end;

function GetAssociatedApp(const Filename: String): String;
var
  Ext, Key: String;
begin
  // Set default result - no associated application
  Result := '';

  // We must check registry to determine association
  with TRegistry.Create do
  try
    Access := KEY_READ;
    RootKey := HKEY_CLASSES_ROOT;

    // Format filename extension
    Ext := LowerCase(ExtractFileExt(FileName));

    // Lookup logical name for registered extension
    if OpenKey(Ext, False) then
    begin
      Key := ReadString('');
      CloseKey;

      // Open logical file type to determine actions
      if OpenKey(Key, False) then
        if OpenKey('Shell\Open\Command', False) then
          Result := ReadString('');
    end;
  finally
    Free;
  end;
end;

function SetAssociatedApp(const AppFilename, Extension, Description: String): Boolean;
var
  Ext: String;
begin
  // Set default result - failed to add registry keys
  Result := False;

  // We must update registry to associate application
  with TRegistry.Create do
  try
    Access := KEY_WRITE;
    RootKey := HKEY_CLASSES_ROOT;

    // Format filename extension - remove . prefix
    Ext := ExtractFileExt(Extension);
    if Copy(Ext, 1, 1) = '.' then Ext := Copy(Ext, 2, Length(Ext));

    if not OpenKey('.' + Ext, True) then Exit;
    WriteString('', Ext + 'File');
    CloseKey;

    if not OpenKey(Ext + 'File', True) then Exit;
    WriteString('', Description);
    CloseKey;
    
    if not OpenKey(Ext + 'File\DefaultIcon', True) then Exit;
    WriteString('', AppFilename + ',0');
    CloseKey;

    if not OpenKey(Ext + 'File\Shell\Open\Command', True) then Exit;
    WriteString('', AppFilename + ' "%1"');
    CloseKey;

    // Success
    Result := True;
  finally
    Free;
  end;
end;

function EnumAppWindowsProc(Wnd: HWND; Param: LPARAM): BOOL; stdcall;
var
  WindowTitle: array[0..255] of Char;
begin
  // Check for visible or minimized top level non-toolbar app. windows
  if (IsWindowVisible(Wnd) or IsIconic(Wnd)) and
     ((GetParent(Wnd) = 0) or (GetParent(Wnd) = GetDesktopWindow)) and
     (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) and
     (GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD = 0) then
  begin
    GetWindowText(Wnd, WindowTitle, Length(WindowTitle));

    // Don't add phantom GDI+ Windows created by some apps (including mediate)
    if (WindowTitle <> 'GDI+ Window') and (TStringList(Param).IndexOf(WindowTitle) < 0) then
      TStringList(Param).AddObject(WindowTitle, TObject(Wnd));
  end;

  // Continue enumeration
  Result := True;
end;

procedure EnumerateAppWindows(WindowList: TStringList);
begin
  if Assigned(WindowList) then
  begin
    // Clear list and use enumeration procedure above to list app windows
    WindowList.Clear;
    EnumWindows(@EnumAppWindowsProc, LPARAM(WindowList));
  end;
end;

procedure SetFocusAppWindow(Wnd: HWND);
begin
  // Give focus to specified application window
  if Wnd <> 0 then
  begin
    ShowWindow(Wnd, SW_SHOWNORMAL);
    SetForegroundWindow(Wnd);
    SetFocus(Wnd);
  end;
end;

procedure FocusAppWindow(var WindowIndex: Integer; Next: Boolean);
var
  WindowList: TStringList;
begin
  WindowList := TStringList.Create;
  try
    EnumerateAppWindows(WindowList);
    if WindowList.Count > 0 then
    begin
      if Next then Inc(WindowIndex) else Dec(WindowIndex);
      if WindowIndex >= WindowList.Count then WindowIndex := 0;
      if WindowIndex < 0 then WindowIndex := WindowList.Count - 1;

      SetFocusAppWindow(HWND(WindowList.Objects[WindowIndex]));
    end;
  finally
    WindowList.Free;
  end;
end;

//----------------------------------------------------------------------------//

procedure LaunchProcess(ExecutableName, Parameters: String; WaitForCompletion: Boolean);
var
  WorkingDir: String;
begin
  // Determine default working directory
  WorkingDir := ExtractFilePath(ExpandFileName(ExecutableName));

  // Delegate to method below
  LaunchProcess(ExecutableName, Parameters, WorkingDir, WaitForCompletion);
end;

procedure LaunchProcess(ExecutableName, Parameters, WorkingDir: String; WaitForCompletion: Boolean);
var
  ProcessId: Integer;
  ProcessHdl: THandle;
begin
  // Use method below to run process and return its ID
  ProcessId := RunProcess(ExecutableName, Parameters, WorkingDir, False);

  // Attempt to open process for synchronization if required
  if WaitForCompletion then
  begin
    ProcessHdl := OpenProcess(SYNCHRONIZE, False, ProcessId);
    if ProcessHdl <> 0 then
    begin
      WaitForSingleObject(ProcessHdl, INFINITE);
      CloseHandle(ProcessHdl);
    end;
  end;
end;

function RunProcess(ExecutableName, Parameters: String; WaitForIdle: Boolean): Integer;
var
  WorkingDir: String;
begin
  // Determine default working directory
  WorkingDir := ExtractFilePath(ExpandFileName(ExecutableName));

  // Delegate to method below
  Result := RunProcess(ExecutableName, Parameters, WorkingDir, WaitForIdle);
end;

function RunProcess(ExecutableName, Parameters, WorkingDir: String; WaitForIdle: Boolean): Integer;
var
  StartInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  // Set default result - invalid process id
  Result := 0;

  // Clear process parameter structures
  FillChar(StartInfo, SizeOf(TStartupInfo), 0);
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  StartInfo.cb := SizeOf(TStartupInfo);

  // Determine full path for application
  ExecutableName := ExpandFileName(ExecutableName);

  if CreateProcess(PChar(ExecutableName), PChar(Parameters), nil, nil, False,
                   CREATE_NEW_PROCESS_GROUP + NORMAL_PRIORITY_CLASS,
                   nil, PChar(WorkingDir), StartInfo, ProcessInfo) then
  begin
    // We can wait for process to settle down to idle here if we wish
    if WaitForIdle then
      WaitForInputIdle(ProcessInfo.hProcess, INFINITE);

    // Return process id
    Result := ProcessInfo.dwProcessId;
  end;

  // Don't forget to release thread and process handles (we can retain the ID)
  CloseHandle(ProcessInfo.hThread);
  CloseHandle(ProcessInfo.hProcess);
end;

function KillProcess(ProcessId: Integer): Boolean;
var
  ProcessHdl: THandle;
begin
  // Set default result - failed to kill process
  Result := False;

  // Open process for termination
  ProcessHdl := OpenProcess(PROCESS_TERMINATE, False, ProcessId);
  if ProcessHdl <> 0 then
  begin
    // Non-zero return value indicates success
    Result := (Integer(TerminateProcess(ProcessHdl, 0)) <> 0);

    CloseHandle(ProcessHdl);
  end;
end;

function ProcessRunning(const ExecutableName: String): Boolean;
var
  Match: String;
  SnapshotHandle: THandle;
  ProcessEntry32: TProcessEntry32;
  MoreProcesses: BOOL;
begin
  // Set default result - not running
  Result := False;

  // Case insensitive process matching in case someone renames exe
  Match := LowerCase(ExtractFileName(ExecutableName));

  // Take a snapshot of current running processes
  SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    // Select first process in our snapshot
    FillChar(ProcessEntry32, SizeOf(TProcessEntry32), 0);
    ProcessEntry32.dwSize := SizeOf(TProcessEntry32);
    MoreProcesses := Process32First(SnapshotHandle, ProcessEntry32);

    // Keep looping while we find processes
    while MoreProcesses do
    begin
      // Compare executable names
      if Match = LowerCase(ExtractFileName(ProcessEntry32.szExeFile)) then
      begin
        Result := True;
        Break;
      end;

      // Get next process
      MoreProcesses := Process32Next(SnapshotHandle, ProcessEntry32);
    end;
  finally
    // Ensure we release the process snapshot
    CloseHandle(SnapshotHandle);
  end;
end;

//----------------------------------------------------------------------------//

function FileSizeToString(FileSize: Integer): String;
const
  ONE_K = 1024;
  ONE_MB = 1024 * ONE_K;
  ONE_GB = 1024 * ONE_MB;
begin
  // Decide whether we should report filesize in GB, MB, KB or Bytes
  if FileSize >= ONE_GB then Result := Format('%.2f GB', [FileSize / ONE_GB])
  else if FileSize >= ONE_MB then Result := Format('%.2f MB', [FileSize / ONE_MB])
  else if FileSize >= ONE_K then Result := Format('%.2f KB', [FileSize / ONE_K])
  else Result := Format('%d Bytes', [FileSize]);
end;

function ValidFileName(Filename: String): Boolean;
const
  FORBIDDEN_CHARS: set of Char = ['<', '>', '|', '"', '\', '/', ':', '*', '?'];
var
  i: Integer;
begin
  Result := Filename <> '';

  for i := 1 to Length(Filename) do
    if Filename[i] in FORBIDDEN_CHARS then
    begin
      Result := False;
      Break;
    end;
end;

function MakeUniqueFileName(Filename: String): String;
var
  Suffix: Integer;
begin
  Suffix := 0;

  repeat
    if Suffix = 0 then Result := '' else Result := IntToStr(Suffix);
    Result := ChangeFileExt(Filename, '') + Result + ExtractFileExt(Filename);
    Inc(Suffix);
  until not FileExists(Result);
end;

function ExtractFileCaption(const FileName: String): String;
var
  i: Integer;
begin
  // Extract everything from filename except the extension
  i := LastDelimiter('.' + PathDelim + DriveDelim, FileName);
  if (i > 1) and (FileName[i] = '.') then
    Result := Copy(FileName, 1, i - 1) else
    Result := FileName;
end;

//----------------------------------------------------------------------------//

function ParentFolder(Folder: String): String;
var
  i: Integer;
begin
  // Remove trailing slash from filename
  Result := ExcludeTrailingPathDelimiter(Folder);

  // Trim last folder part from path if found
  i := LastDelimiter(PathDelim, Result);
  Result := Copy(Result, 1, i);
end;

function LastFolder(Path: String): String;
var
  i: Integer;
begin
  // Remove trailing slash from filename
  Result := ExcludeTrailingPathDelimiter(Path);

  // Trim last folder part from path if found
  i := LastDelimiter(PathDelim, Result);
  Result := Copy(Result, i + 1, MaxInt);

  // Add trailing slash to filename
  if Result <> '' then Result := IncludeTrailingPathDelimiter(Result);
end;

// ChooseFolder callback method to set initial folder
function ChooseFolderCallBack(Handle: HWND; Msg: UINT; lp, pData: LPARAM): Integer stdcall;
begin
  // We only want to handle the initialized message, which is when we set initial folder
  if (Msg = BFFM_INITIALIZED) and (FChooseInitialFolder <> '') then
    SendMessage(Handle, BFFM_SETSELECTION, 1, LPARAM(FChooseInitialFolder));
  Result := 0;
end;

function ChooseFolder(const Title: String; var Folder: String; AllowCreate: Boolean): Boolean;
var
  BrowseInfo: TBrowseInfo;
  FindContext: PItemIDList;
  Selection: array[0..MAX_PATH] of Char;
begin
  // Set default result - didn't pick a folder
  Result := False;

  // Initialise browse info structure
  FillChar(BrowseInfo, SizeOf(TBrowseInfo), 0);
  BrowseInfo.hwndOwner := Application.Handle;
  BrowseInfo.lpszTitle := PChar(Title);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  if AllowCreate then
    BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_EDITBOX
  else
    BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_NONEWFOLDERBUTTON;

  // Store initial directory to show & hookup callback
  if DirectoryExists(Folder) then
    FChooseInitialFolder := Folder
  else
    FChooseInitialFolder := ParentFolder(Folder);
  BrowseInfo.lpfn := ChooseFolderCallBack;

  // Invoke API to make selection
  FindContext := SHBrowseForFolder(BrowseInfo);
  if Assigned(FindContext) then
  begin
    // Convert returned item id into a system path
    if SHGetPathFromIDList(FindContext, Selection) then
    begin
      Folder := Selection;
      Result := True;
    end;

    // Ensure we release shell resources
    GlobalFreePtr(FindContext);
  end;
end;

function ChooseFile(const Title: String; var Filename: String; AllowCreate: Boolean): Boolean;
var
  Root: String;
begin
  // Derive root folder from current filename
  Root := ExtractFilePath(Filename);

  Result := ChooseFile(Title, '', '', Root, Filename, AllowCreate);
end;

function ChooseFile(const Title, Filter, DefaultExt, Root: String; var Filename: String; AllowCreate: Boolean): Boolean;
begin
  Result := PromptForFileName(Filename, Filter, DefaultExt, Title, Root, AllowCreate);
end;

//----------------------------------------------------------------------------//

function GetWindowsPath(Kind: TAHMWindowsPaths): String;
const
  CSIDL_PERSONAL = $0005;
  CSIDL_APPDATA = $001A;
  CSIDL_WINDOWS = $0024;
  CSIDL_SYSTEM = $0025;
  CSIDL_PROGRAM_FILES = $0026;
  CSIDL_MYPICTURES = $0027;
  CSIDL_MYMUSIC = $000D;
  CSIDL_MYVIDEO = $000E;
var
  PBuff: array[0..MAX_PATH] of Char;
  CSIDL: Integer;
begin
  // Set default result - no path found
  Result := '';

  // Lookup CSIDL for appropriate path type
  case Kind of
    wpWindows: CSIDL := CSIDL_WINDOWS;
    wpSystem: CSIDL := CSIDL_SYSTEM;
    wpAppData: CSIDL := CSIDL_APPDATA;
    wpProgramFiles: CSIDL := CSIDL_PROGRAM_FILES;
    wpMyDocuments: CSIDL := CSIDL_PERSONAL;
    wpMyMusic: CSIDL := CSIDL_MYMUSIC;
    wpMyVideos: CSIDL := CSIDL_MYVIDEO;
    wpMyPictures: CSIDL := CSIDL_MYPICTURES;
    else Exit;
  end;

  if SHGetSpecialFolderPath(Application.Handle, PBuff, CSIDL, False) then
    Result := PBuff;
end;

function GetVolumeName(Path: String): String;
var
  PBuff: array[0..MAX_PATH] of Char;
  Serial, MaxLength, Flags: DWORD;
begin
  Path := ExtractFileDrive(Path);
  if GetVolumeInformation(PChar(Path), PBuff, MAX_PATH, @Serial, MaxLength, Flags, nil, 0) then
    Result := PBuff
  else
    Result := '';
end;

procedure GetDrives(Drives: TStrings; DriveTypes: TAHMDriveTypes);
var
  DriveBits: DWORD;
  DriveType: TAHMDriveType;
  Path: String;
  i: Integer;
begin
  if not Assigned(Drives) then Exit;

  // First get a bitmask of all available drives on system
  DriveBits := GetLogicalDrives;
  for i := 0 to 25 do
  begin
    // Test LSB - set if this drive is mounted
    if (DriveBits and 1) > 0 then
    begin
      Path := Chr(Ord('A') + i) + ':\';
      case GetDriveType(PAnsiChar(Path)) of
        DRIVE_REMOVABLE: DriveType := drvRemovable;
        DRIVE_FIXED: DriveType := drvFixed;
        DRIVE_REMOTE: DriveType := drvNetwork;
        DRIVE_CDROM: DriveType := drvOptical;
        else DriveType := drvUnknown;
      end;

      if DriveType in DriveTypes then
        Drives.AddObject(Path, TObject(DriveType));
    end;

    // Shift bitmask to get next drive
    DriveBits := DriveBits shr 1;
  end;
end;

//----------------------------------------------------------------------------//

procedure EnumerateSerialPorts(Names, Descriptions: TStrings);
var
  Locator, Service, Ports: Variant;
  Enum: IEnumVariant;
  Port: OleVariant;
  Fetch: Cardinal;
begin
  try
    // Use Windows Management Instrumentation (WMI) to interrogate serial ports
    Locator := CreateOleObject('WbemScripting.SWbemLocator');
    Service := Locator.ConnectServer();
    Ports := Service.InstancesOf('Win32_SerialPort');
    Enum := IUnknown(Ports._NewEnum) as IEnumVariant;
    
    while (Enum.Next(1, Port, Fetch) = S_OK) and (Fetch > 0) do
    begin
      if Assigned(Names) then Names.Add(Port.DeviceId);
      if Assigned(Descriptions) then Descriptions.Add(Port.Name);
    end;
  except
    // Ignore errors if WMI not installed or unexpected API change
  end;
end;

//----------------------------------------------------------------------------//

function DurationToString(Millisecs: Cardinal): String;
begin
  // Convert milliseconds to TDateTime (no. of days)
  Result := DurationToString(Millisecs / MSecsPerDay);
end;

function DurationToString(Duration: TDateTime): String;
var
  Days, Hours, Mins, Secs, MSecs: Word;

  procedure FormatDuration(Value: Integer; const Prefix: String; var Output: String);
  var
    Work: String;
  begin
    if Value = 0 then Work := ''
    else if Value = 1 then Work := IntToStr(Value) + Prefix
    else Work := IntToStr(Value) + Prefix + 's';

    if Work <> '' then
      if Result <> '' then Result := Result + ', ' + Work
                      else Result := Work;
  end;
begin
  // Convert milliseconds to TDateTime (no. of days)
  Days := Round(Int(Duration));
  DecodeTime(Frac(Duration), Hours, Mins, Secs, MSecs);

  Result := '';
  FormatDuration(Days, ' day', Result);
  FormatDuration(Hours, ' hour', Result);
  FormatDuration(Mins, ' minute', Result);
  FormatDuration(Secs, ' second', Result);
end;

function FrequencyToString(Frequency: LongWord): String;
begin
  if Frequency > 1000 then
    Result := IntToStr(Frequency div 1000) + 'K'
  else if Frequency > 0 then
    Result := IntToStr(Frequency) + 'fps'
  else
    Result := '';
end;

//----------------------------------------------------------------------------//

function IsWindowsVista: Boolean;   
var
  VerInfo: TOSVersioninfo;
begin
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(VerInfo);
  Result := VerInfo.dwMajorVersion >= 6;
end;

procedure RemoveApplicationWindowFromTaskbar;
var
  Flags: LongInt;
begin
  // Tweak window flags for hidden application window to remove it from taskbar
  with Application do
  begin
    ShowWindow(Handle, SW_HIDE);
    Flags := GetWindowLong(Handle, GWL_EXSTYLE);
    SetWindowLong(Handle, GWL_EXSTYLE, Flags and not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);
    ShowWindow(Handle, SW_SHOW);
  end;
end;

function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType): Integer;
begin
  // Delegate to method below
  Result := TaskMsgDialog(Title, Description, Text, DlgType, [mbOk], 0, mbOk);
end;

function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType;
                       Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
  // Delegate to method below
  Result := TaskMsgDialog(Title, Description, Text, DlgType, Buttons, HelpCtx, mbHelp);
end;

function TaskMsgDialog(const Title, Description, Text: String; DlgType: TMsgDlgType;
                       Buttons: TMsgDlgButtons; HelpCtx: Longint; Default: TMsgDlgBtn): Integer;
const
  TD_ICON_BLANK = 0;
  TD_ICON_WARNING = 84;
  TD_ICON_QUESTION = 99;
  TD_ICON_ERROR = 98;
  TD_ICON_INFORMATION = 81;
  TD_ICON_SHIELD_QUESTION = 104;
  TD_ICON_SHIELD_ERROR = 105;
  TD_ICON_SHIELD_OK = 106;
  TD_ICON_SHIELD_WARNING = 107;

  TD_BUTTON_OK = 1;
  TD_BUTTON_YES = 2;
  TD_BUTTON_NO = 4;
  TD_BUTTON_CANCEL = 8;
  TD_BUTTON_RETRY = 16;
  TD_BUTTON_CLOSE = 32;

  TD_RESULT_OK = 1;
  TD_RESULT_CANCEL = 2;
  TD_RESULT_RETRY = 4;
  TD_RESULT_YES = 6;
  TD_RESULT_NO = 7;
  TD_RESULT_CLOSE = 8;
var
  Content: String;
  DLLHandle: THandle;
  IconType, BtnFlags, Choice: Integer;
  wTitle, wDescription, wContent: array[0..1024] of WideChar;
  TaskDialog: function(HWND: THandle; hInstance: THandle; cTitle, cDescription,
                       cContent: PWideChar; Buttons: Integer; Icon: integer;
                       ResButton: PInteger): Integer; cdecl stdcall;
begin
  // Revert to standard Delphi MessageDlg if not running on Vista
  if not IsWindowsVista then
    Result := MessageDlg(Text, DlgType, Buttons, HelpCtx)
  else
  begin
    // Map dialog type to Vista icon type
    case DlgType of
      mtWarning:      IconType := TD_ICON_WARNING;
      mtConfirmation: IconType := TD_ICON_QUESTION;
      mtError:        IconType := TD_ICON_ERROR;
      mtInformation:  IconType := TD_ICON_INFORMATION;
      else            IconType := TD_ICON_BLANK;
    end;

    // Map dialog buttons to Vista button flags
    if mbOK in Buttons then BtnFlags := TD_BUTTON_OK else BtnFlags := 0;
    if mbYes in Buttons then BtnFlags := BtnFlags + TD_BUTTON_YES;
    if mbNo in Buttons then BtnFlags := BtnFlags + TD_BUTTON_NO;
    if mbCancel in Buttons then BtnFlags := BtnFlags + TD_BUTTON_CANCEL;
    if mbRetry in Buttons then BtnFlags := BtnFlags + TD_BUTTON_RETRY;
    if mbAbort in Buttons then BtnFlags := BtnFlags + TD_BUTTON_CLOSE;

    // Load and check correct version of common controls library
    DLLHandle := LoadLibrary(comctl32);
    if DLLHandle < 32 then
      Result := MessageDlg(Text, DlgType, Buttons, HelpCtx)
    else
    begin
      // Fail over to standard MessageDlg if method not found
      @TaskDialog := GetProcAddress(DLLHandle, 'TaskDialog');
      if not Assigned(TaskDialog) then
        Result := MessageDlg(Text, DlgType, Buttons, HelpCtx)
      else
      begin
        // Build parameter strings
        StringToWideChar(Title, wTitle, SizeOf(wTitle));
        StringToWideChar(Description, wDescription, SizeOf(wDescription));

        // Strip line breaks
        Content := StringReplace(Text, #10, '', [rfReplaceAll]);
        Content := StringReplace(Content, #13, '', [rfReplaceAll]);
        StringToWideChar(Text, wContent, SizeOf(wContent));

        // Show the task dialog
        TaskDialog(Application.MainForm.Handle, 0, wTitle, wDescription, wContent,
                   BtnFlags, IconType, @Choice);

        case Choice of
          TD_RESULT_CANCEL: Result := mrCancel;
          TD_RESULT_RETRY: Result := mrRetry;
          TD_RESULT_YES: Result := mrYes;
          TD_RESULT_NO: Result := mrNo;
          TD_RESULT_CLOSE: Result := mrAbort;
          else Result := mrOK;
        end;
      end;
      FreeLibrary(DLLHandle);
    end;
  end;
end;


initialization
  // Record status of various system settings we might change
  GetSystemScreenSaverStatus;
  GetDefaultScreenBrightness;
  GetSystemBalloonTipsStatus;
  FApplicationVersion := '';

end.
